home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / PRINTING.SWG / 0006_PRINTER.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  7KB  |  222 lines
  1. {$S-,R-,V-,I-,N-,B-,F-}
  2.  
  3. {$IFNDEF Ver40}
  4. {Allow overlays}
  5. {$F+,O-,X+,A-}
  6. {$ENDIF}
  7.  
  8. {$DEFINE AssignLstDevice}
  9.  
  10. UNIT Printer;
  11.  
  12. INTERFACE
  13.  
  14. CONST
  15.  
  16.   fmClosed = $D7B0;               { magic numbers for Turbo }
  17.   fmInput = $D7B1;
  18.   fmOutput = $D782;
  19.   fmInOut = $D7B3;
  20.  
  21.   IO_Invalid = $FC;               { invalid operation eg. attempt to write }
  22.   { to a file opened in fmInput mode       }
  23.  
  24.   LPTNames : ARRAY [0..2] OF STRING [4] = ('LPT1', 'LPT2', 'LPT3');
  25.  
  26.   LPTPort : BYTE = 0;
  27.  
  28. VAR
  29.   Lst : TEXT;                     { for source compatability with TP3 }
  30.  
  31. FUNCTION GetROMPrinterStatus (LPTNo : WORD) : BYTE;
  32.   { status of LPTNo via ROM BIOS int 17h func 2h }
  33.   INLINE (
  34.     $5A /                         {  pop     DX    ; get printer number}
  35.     $B4 / $02 /                   {  mov     AH,02 ; set AH for BIOS int 17h function 0}
  36.     $CD / $17 /                   {  int     $17   ; do an int 17h}
  37.     $86 / $E0);                   {  xchg    AL,AH ; put byte result in AL}
  38.  
  39. FUNCTION DoInt17 (Ch : CHAR; LPTNo : WORD) : BYTE;
  40.   { send a character to LPTNo via ROM BIOS int 17h func 0h }
  41.   INLINE (
  42.     $5A /                         {  pop     DX    ; get printer number}
  43.     $58 /                         {  pop     AX    ; get char}
  44.     $B4 / $00 /                   {  mov     AH,00 ; set AH for BIOS int 17h function 0}
  45.     $CD / $17 /                   {  int     $17   ; do an int 17h}
  46.     $86 / $E0);                   {  xchg    AL,AH ; put byte result in AL}
  47.  
  48. PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);
  49.   { like Turbo's assign, except associates Text variable with one of the LPTs }
  50.  
  51. PROCEDURE OutputToFile (FName : STRING);
  52.   {redirect printer output to file }
  53.  
  54. FUNCTION  PrinterStatus (LPTNum : BYTE) : BYTE;
  55.  
  56. FUNCTION  Printer_OK : BOOLEAN;
  57.  
  58. PROCEDURE SelectPrinter (LPTNum : BYTE);
  59.  
  60. PROCEDURE ResetPrinter;           { only resets printer 0 }
  61.  
  62. IMPLEMENTATION
  63.  
  64. TYPE
  65.   TextBuffer = ARRAY [0..127] OF CHAR;
  66.  
  67.   TextRec = RECORD
  68.               Handle   : WORD;
  69.               Mode     : WORD;
  70.               BufSize  : WORD;
  71.               Private  : WORD;
  72.               BufPos   : WORD;
  73.               BufEnd   : WORD;
  74.               BufPtr   : ^TextBuffer;
  75.               OpenFunc : POINTER;
  76.               InOutFunc : POINTER;
  77.               FlushFunc : POINTER;
  78.               CloseFunc : POINTER;
  79.               { 16 byte user data area, I use 4 bytes }
  80.               PrintMode : WORD;   { not currently used}
  81.               LPTNo : WORD;       { LPT number in [0..2] }
  82.               UserData : ARRAY [1..12] OF CHAR;
  83.               Name : ARRAY [0..79] OF CHAR;
  84.               Buffer : TextBuffer;
  85.             END;
  86. CONST
  87.   LPTFileopen : BOOLEAN = FALSE;
  88.  
  89. VAR
  90.   LPTExitSave : POINTER;
  91.  
  92.   PROCEDURE Out_Char (Ch : CHAR; LPTNo : WORD; VAR ErrorCode : INTEGER);
  93.     { call macro to send char to LPTNo.  If bit 4, the Printer Selected bit }
  94.     { is not set upon return, it is assumed that an error has occurred.     }
  95.  
  96.   BEGIN
  97.     ErrorCode := DoInt17 (Ch, LPTNo);
  98.     IF (ErrorCode AND $10) = $10 THEN { if bit 4 is set }
  99.       ErrorCode := 0              { no error }
  100.       { if bit 4 is not set, error is passed untouched and placed in IOResult }
  101.   END;
  102.  
  103.   FUNCTION LstIgnore (VAR F : TextRec) : INTEGER;
  104.     { A do nothing, no error routine }
  105.   BEGIN
  106.     LstIgnore := 0                { return 0 for IOResult }
  107.   END;
  108.  
  109.   FUNCTION LstOutput (VAR F : TextRec) : INTEGER;
  110.     { Send whatever has accumulated in the Buffer to int 17h   }
  111.     { If error occurs, return in IOResult.  See Inside Turbo   }
  112.     { Pascal chapter of TP4 manual for more info on TFDD       }
  113.   VAR
  114.     I : WORD;
  115.     ErrorCode : INTEGER;
  116.  
  117.   BEGIN
  118.     LstOutput := 0;
  119.     WITH F DO BEGIN
  120.       FOR I := 0 TO PRED (BufPos) DO BEGIN
  121.         Out_Char (BufPtr^ [I], LPTNo, ErrorCode); { send each char to printer }
  122.         IF ErrorCode <> 0 THEN BEGIN { if error }
  123.           LstOutput := ErrorCode; { return errorcode in IOResult }
  124.           EXIT                    { return from function }
  125.         END
  126.       END;
  127.       BufPos := 0
  128.     END;
  129.   END;
  130.  
  131.   PROCEDURE AssignLst (VAR F : TEXT; LPTNumber : WORD);
  132.     { like Turbo's assign, except associates Text variable with one of the LPTs }
  133.  
  134.   BEGIN
  135.     WITH TextRec (F) DO
  136.       BEGIN
  137.         Mode := fmClosed;
  138.         BufSize := SIZEOF (Buffer);
  139.         BufPtr := @Buffer;
  140.         OpenFunc := @LstIgnore;   { you don't open the BIOS printer functions }
  141.         CloseFunc := @LstIgnore;  { nor do you close them }
  142.         InOutFunc := @LstOutput;  { but you can Write to them }
  143.         FlushFunc := @LstOutput;  { and you can WriteLn to them }
  144.         LPTNo := LPTNumber;       { user selected printer num (in [0..2]) }
  145.         MOVE (LPTNames [LPTNumber], Name, 4); { set name of device }
  146.         BufPos := 0;              { reset BufPos }
  147.       END;
  148.   END;
  149.  
  150.   PROCEDURE OutputToFile (FName : STRING);
  151.   BEGIN
  152.     ASSIGN (Lst, FName);
  153.     REWRITE (Lst);
  154.     LPTFileopen := TRUE;
  155.   END;
  156.  
  157.   FUNCTION PrinterStatus (LPTNum : BYTE) : BYTE;
  158.   VAR
  159.     Status : BYTE;
  160.   BEGIN
  161.     Status := GetROMPrinterStatus (LPTNum);
  162.     IF (Status AND $B8) = $90 THEN
  163.       PrinterStatus := 0          {all's well}
  164.     ELSE IF (Status AND $20) = $20 THEN
  165.       PrinterStatus := 1          {no Paper}
  166.     ELSE IF (Status AND $10) = $00 THEN
  167.       PrinterStatus := 2          {off line}
  168.     ELSE IF (Status AND $80) = $00 THEN
  169.       PrinterStatus := 3          {busy}
  170.     ELSE IF (Status AND $08) = $08 THEN
  171.       PrinterStatus := 4;         {undetermined error}
  172.   END;
  173.  
  174.   FUNCTION Printer_OK : BOOLEAN;
  175.   VAR
  176.     Retry : BYTE;
  177.   BEGIN
  178.     Retry := 0;
  179.     WHILE (PrinterStatus (LPTPort) <> 0) AND (Retry < 255) DO INC (Retry);
  180.     Printer_OK := (PrinterStatus (LPTPort) = 0);
  181.   END;                            {PrinterReady}
  182.  
  183.   PROCEDURE SelectPrinter (LPTNum : BYTE);
  184.   BEGIN
  185.     IF (LPTNum >= 0) AND (LPTNum <= 3) THEN
  186.       LPTPort := LPTNum;
  187.     AssignLst (Lst, LPTPort);      { set up turbo 3 compatable Lst device }
  188.     REWRITE (Lst);
  189.   END;
  190.  
  191.   PROCEDURE ResetPrinter;
  192.   VAR
  193.     address : INTEGER ABSOLUTE $0040 : $0008;
  194.     portno, DELAY : INTEGER;
  195.   BEGIN
  196.     portno := address + 2;
  197.     Port [portno] := 232;
  198.     FOR DELAY := 1 TO 2000 DO {nothing} ;
  199.     Port [portno] := 236;
  200.   END;                            {ResetPrinter}
  201.  
  202.   PROCEDURE LptExitHandler; FAR;
  203.   BEGIN
  204.     IF LPTFileopen THEN CLOSE (Lst);
  205.     ExitProc := LPTExitSave;
  206.   END;
  207.  
  208. BEGIN
  209.  
  210.   LPTExitSave := ExitProc;
  211.   ExitProc := @LptExitHandler;
  212.  
  213.   {$IFDEF AssignLstDevice}
  214.  
  215.   LPTPort := 0;
  216.   AssignLst (Lst, LPTPort);        { set up turbo 3 compatable Lst device }
  217.   REWRITE (Lst);
  218.  
  219.   {$ENDIF}
  220.  
  221. END.
  222.